home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / Yerk 3.64 ƒ / System source / Frontend < prev    next >
Encoding:
Text File  |  1993-05-24  |  7.5 KB  |  259 lines  |  [TEXT/ttxt]
  1. \ frontEnd - menus and handlers for Yerk menu bar
  2. \ 12/20/84  cbd Version 1
  3. \  7/05/86  cdn Added HFS references
  4. \  7/09/86  cdn Expanded Util & Yerk menus; added .ok
  5. \  8/10/86  cdn Added savefW, restfW, enfW, disfW
  6. \  8/31/88    rfl made parmstr object of string; added show: fwind in yerk
  7. \ 10/04/88    rfl    brought back old npath
  8. \ 10/03/90    rfl    added 0 ?event drop to get window out in front in mf
  9. \  3/23/91    rfl    don't check for hfs ..just assume
  10. \  5/10/91    rfl    editor name now at string resource id 99
  11. \  6/09/91    rfl modified editor name...in rsrc, make sure it starts with two zeros
  12. \ 11/17/91    rfl    added 7.0.1 fix readFP before saving image
  13. \  4/24/92    rfl    added closeAll for development
  14. \  5/14/92    rfl    removed savefw
  15. \ 10/14/92    rfl    sysedits now supports key: window; cut,copy,paste for the front window
  16. \  1/02/93    rfl    menus now in resources. Old menu module still available, though.
  17. \  5/03/93    rfl    added new tool1 for testing
  18. \  5/20/93    rfl    added saver to save currently named document in same folder as original
  19. Decimal
  20.  
  21. \ mark the Yerk menubar layer for forgets
  22. : FrontEnd ;
  23.  
  24. create inLine $ 4ed4 w, \ next,    \ for inline trap calls jmp (a4)
  25.  
  26. from tool1 import{ asmcall1 call1 global1 } 2 immediates
  27.  
  28. Create (flush) popD0 " FlushEvents" asmCall next,
  29. Create (post) popD0 popA0 " PostEvent" asmCall next,
  30. : .ok 8 (flush) 3 13 (post) ;
  31.  
  32. \ ============== Menu handlers =================
  33.  
  34. \ define the menus for the Yerk menu bar
  35. 5 menu FileMen
  36. 8 menu EditMen
  37. 9 menu UtilMen
  38. 9 menu YerkMen
  39.  
  40. BasicStr imageName
  41. string parmStr
  42.  
  43. \ get file from stdFile and load it as source
  44. : stdLoad
  45.     new: loadFile
  46.     txType 1 stdGet: topFile
  47.     draw: fWind
  48.     IF interpret: topFile .ok THEN
  49.     remove: loadFile ;
  50.  
  51. : readFP " fpInit" sFind
  52.     IF 2drop 5 'type CODE (getres) dup >ptr 'f> rot 0 swap call SizeResource cmove 
  53.     THEN ;
  54.  
  55. \ Resave current dictionary
  56. : doSave .cur readFP
  57.     get: imageName  name: fFcb (save)
  58.     curs -curs cr ." Saved: " print: imageName cr
  59.     -> curs .ok ;
  60.  
  61. \ save via stdFile
  62. : stdSave .cur
  63.     " Save Dictionary As:"  get: imageName str255 -base count
  64.     stdPut: fFcb
  65.     draw: fWind
  66.     IF  readFP (save)
  67.         getVref: ffcb finfo 4+ w!    \ save vref in finfo area
  68.         getName: fFcb 2dup put: imageName title: fWind
  69.         curs -curs cr ." Saved: " print: imageName cr
  70.         -> curs .ok
  71.     THEN ;
  72.  
  73. \ Save current document in same directory as initial document, or the
  74. \   last stdSave'd document...take name from
  75. \   the fwind (which should be the last stdSave'd document)
  76. : Saver readFP
  77.         get: imageName name: fFcb finfo 4+ w@ setVref: fFcb (save)
  78.      ." Saved: " print: imageName cr ;
  79.  
  80. \ Select and print a text file
  81. : Print
  82.     new: loadFile
  83.     txType 1 stdGet: topFile
  84.     draw: fWind
  85.     IF qPrint THEN
  86.     remove: loadfile ;
  87.  
  88. \ ============== Edit Menu =================
  89.  
  90. \ scrap support
  91. Var  theOffset
  92.  
  93. : getScrap
  94.     0 handle: parmStr  txType abs: theOffset
  95.     call GetScrap ;
  96.  
  97. \ get next char from the scrap
  98. : scrapKey
  99.     next: parmStr 0=
  100.     IF rekey 13 THEN ;    \ simulate a terminal cr
  101.  
  102. \ interpret from the scrap
  103. : xDoit
  104.     getScrap 0>
  105.     IF 0 moveTo: parmStr 'c scrapKey -> keyVec
  106.     THEN  sp! mp! quit ;
  107.  
  108. : frontWind 0 call frontwindow -base ;
  109.  
  110. \ editing commands pass thru to desk accessories
  111. : sysEd   >R word0 R> makeInt call SysEdit word0 ;
  112. : sysCut    2 sysEd not IF msg: fevent key: [ frontWind ] THEN ;
  113. : sysCopy   3 sysEd not IF msg: fevent key: [ frontWind ] THEN ;
  114. \ pastes only into the fwind...
  115. : sysPaste  { \ theWInd -- } 4 sysEd not
  116.         IF frontWind -> theWind
  117.             theWind fwind =
  118.             IF xDoit
  119.             ELSE msg: fevent key: theWind
  120.             THEN
  121.         THEN ;
  122. : sysClear  5 sysEd drop ;
  123.  
  124. \ this string holds the name of the McSink desk accessory
  125. : edName 99 getString ;    \ leading null char
  126. : doEdit   savePort word0 edName str255 call OpenDeskAcc word0 drop restPort ;
  127.  
  128. \ ============== Util Menu =================
  129.  
  130. \ call words from utility module
  131. : doWords .cur
  132.     curs -curs words -> curs .ok ;
  133.  
  134. \ start the object list utility via its input dialog
  135. : doOlist
  136.     " List objects of class:" doInDlg
  137.     IF over +base over >uc objList .ok THEN ;
  138.  
  139. \ start the object list with a word in the stream
  140. : do' @word count objList ;
  141.  
  142. \ run the class lister
  143. : doClist .classes .ok ;
  144.  
  145. \ start the decompile utility via its input dialog
  146. : doDe
  147.     " Enter word to decompile:" doDeDlg
  148.     IF  tib 128 erase  0 -> in    \ simulate terminal input from dialog text
  149.         tib swap cMove de' .ok
  150.     THEN ;
  151.  
  152. \ start the grep utility via its input dialog
  153. : doGrep
  154.     " Enter string for search:" doGrDlg
  155.     IF (grep) .ok THEN ;
  156.  
  157. \ ============== Yerk Menu =================
  158.  
  159. \ ( item# b -- ) check item if boolean is true
  160. : chkYerk
  161.     IF   check: yerkMen
  162.     ELSE unCheck: yerkMen
  163.     THEN ;
  164.  
  165. 0 value prEcho
  166. 0 value LEcho
  167.  
  168. : ?yerkFlgs  3 LEcho chkYerk 2 dEcho chkYerk  1 prEcho chkYerk ;
  169.  
  170. \ toggle echo to printer
  171. : pEcho
  172.     precho 1 xor -> prEcho prEcho
  173.     IF +print
  174.     ELSE -print dispose> printMod
  175.     THEN ?yerkFlgs ;
  176.  
  177. \ toggle echo during loads
  178. : ldEcho  decho 1 xor -> decho  ?yerkFlgs ;
  179.  
  180. : logging LEcho 1 xor -> LEcho LEcho
  181.     IF +file
  182.     ELSE -file dispose> logMod
  183.     THEN ?yerkflgs ;
  184.  
  185. \ print path list
  186. : .path path IF cr print: path ELSE ." No paths defined." THEN .ok ;
  187.  
  188. \ ( -- maxBlk )  Call register-based toolbox routine
  189. create maxmem
  190.     " MaxMem" asmCall
  191.     pushD0
  192.     next,
  193.  
  194. \ print room remaining in heap, dictionary
  195. : .room cr maxmem    \ compression first
  196.     ." Room in Dictionary:    " room 6 .r cr
  197.     ." Total Heap (no purge): " free 6 .r cr
  198.     ." Largest Block (purge): "      6 .r cr .ok ;
  199.  
  200. : doMlist .mods .ok ;
  201.  
  202. \ note that doSave has been replaced with saver
  203.  2 'cfas about null                                                    1 put: appleMen
  204.  5 'cfas stdLoad Saver stdSave Print bye                            2 put: fileMen
  205.  8 'cfas null null sysCut sysCopy sysPaste sysClear null doEdit        3 put: editMen
  206.  9 'cfas doWords doOlist doClist hier exam doDe doGrep null install    4 put: utilMen
  207.  9 'cfas pEcho ldEcho logging null .path .room doMlist purge null    5 put: yerkMen
  208.  
  209. : nmenu applemen fileMen editMen utilMen yerkMen 5 init: menubar ;
  210.  
  211. \ ============== Non-Menu related words =================
  212.  
  213. \ Set the maximum dictionary size that Yerk will allow
  214. \ on a large memory Mac.  This is done so that on a large system, more heap
  215. \ will be available for modules, etc. than the amount set for a small
  216. \ machine (~22K). The heap is given whatever is left over from the maximum
  217. \ dictionary size, down to a minimum of the value set in Install.
  218. \ You should do a Save using Install after setting this value to save the
  219. \ Yerk nucleus file to disk.
  220. \ ( max-bytes -- )
  221. : maxDict  msize ! ;
  222.  
  223. \ disable/enable actions for fWind
  224. : disfW
  225.     1 disable: FileMen 2 disable: FileMen 3 disable: FileMen
  226.     0 disable: UtilMen 0 disable: YerkMen ;
  227. :  enfW
  228.     1  enable: FileMen 2  enable: FileMen 3  enable: FileMen
  229.     0  enable: UtilMen 0  enable: YerkMen ;
  230.  
  231. \ close all windows except for the fwind
  232. : closeAll { \ theWindow -- } 0 call frontWindow
  233.     BEGIN -base -> theWindow
  234.           theWindow $ 90 + @                \ get next window in list
  235.           theWindow fwind <>                \ don't close fwind
  236.           IF close: theWindow THEN dup 0=    \ continue until no more windows
  237.     UNTIL drop set: fwind ;
  238.  
  239. : nPath " ::Yerk folder:nPath.txt" getPtxt ;
  240.  
  241. \ system startup word
  242. : yerk
  243.     sysInit    \ Initialize nucleus objects - fFcb, fEvent, fpRect, fWind
  244.     " fpInit" sFind IF drop cfa execute THEN    \ Initialize FP system
  245.     0 ?event drop abs: fWind call BeginUpdate
  246.     getVrect: fWind 14 + put: tempRect update: tempRect
  247.     abs: fWind call EndUpdate
  248.     initNewWindow: fwind show: fwind
  249.     <[ 2 ]> 'cfas enfW disfW setAct: fWind    \ fWind activate activities
  250.     OpenNR
  251.     new: imageName  new: parmStr
  252.     nPath
  253.     nMenu                                     \ get Yerk menu bar
  254.     initProcs                                \ loads all proc words with a5,a3
  255.     myDoc 2dup put: imageName title: fWind    \ fWind title bar
  256.     ?yerkFlgs release ;
  257.  
  258. 'c yerk -> objInit
  259.